home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2002 #11 / Amiga Plus CD - 2002 - No. 11.iso / Tools / Development / PowerD / powerd / source / pr2m.d < prev    next >
Encoding:
Text File  |  2002-10-28  |  4.6 KB  |  222 lines
  1. /* 30.9.1999 v1.0 first initial release
  2. ** 9.12.2001 v1.1 translated to PowerD, fixed a string (reported by DMX)
  3. */
  4.  
  5. PROC main()
  6.     DEF    args:PTR TO LONG,ra,
  7.             name[256]:STRING,dest[256]:STRING,
  8.             src:PTR TO CHAR,l,f=NIL
  9.     args:=['diskfont',NIL]:LONG
  10.     IF ra:=ReadArgs('SOURCE/A,SASC/S',args,NIL)
  11.         IF args[1]
  12.             StringF(name,'\s_pragmas.h',args[0])
  13.         ELSE
  14.             StringF(name,'\s_lib.h',args[0])
  15.         ENDIF
  16.         StringF(dest,'\s.m',args[0])
  17.         IF (l:=FileLength(name))>0
  18.             IF src:=New(l)
  19.                 IF f:=Open(name,OLDFILE)
  20.                     Read(f,src,l)
  21.                     Close(f)
  22.                 ELSE
  23.                     PrintFault(IOErr(),'pr2m')
  24.                 ENDIF
  25.                 IF f
  26.                     IF f:=Open(dest,NEWFILE)
  27.                         IF args[1] THEN ConvertSASC(f,src,l) ELSE Convert(f,src,l)
  28.                         VFPrintF(f,'\n',NIL)
  29.                         Close(f)
  30.                     ELSE
  31.                         PrintFault(IOErr(),'pr2m')
  32.                     ENDIF
  33.                 ENDIF
  34.                 Dispose(src)
  35.             ENDIF
  36.         ELSE
  37.             PrintFault(IOErr(),'pr2m')
  38.         ENDIF
  39.         FreeArgs(ra)
  40.     ELSE
  41.         PrintFault(IOErr(),'pr2m')
  42.     ENDIF
  43. ENDPROC
  44.  
  45. PROC Convert(f,src:PTR TO CHAR,l)
  46.     DEF    p=0,type,head=FALSE,name[256]:STRING,offset,i
  47.     WHILE p<l
  48.         WHILE src[p]<>"#"
  49.             p++
  50.             IF p>=l THEN RETURN
  51.             IF CtrlC() THEN RETURN
  52.         ENDWHILE
  53.         IF StrCmp('#pragma',src+p,7)
  54.             p:=Skip(src,p+7,l)
  55.             p:=GetName(name,src,p,l)
  56.             IF StrCmp('amicall',name)
  57.                 type:="AMIC"
  58.             ELSEIF StrCmp('tagcall',name)
  59.                 type:="TAGC"
  60.             ELSE
  61.                 PrintF('Only amicall and tagcall allowed (\s).\n',name)
  62.                 RETURN
  63.             ENDIF
  64.             IF type
  65.                 p:=Skip(src,p,l)
  66.                 IF src[p]="("
  67.                     p:=Skip(src,p+1,l)
  68.                     p:=GetName(name,src,p,l)
  69.                     IF head=FALSE
  70.                         VFPrintF(f,'LIBRARY \s\n',[name])
  71.                         head:=TRUE
  72.                     ELSE
  73.                         VFPrintF(f,',\n',NIL)
  74.                     ENDIF
  75.                 ELSE
  76.                     PrintF('"(" expected.\n')
  77.                     RETURN
  78.                 ENDIF
  79.  
  80.                 p:=Skip(src,p,l)
  81.                 IF src[p]=","
  82.                     p:=Skip(src,p+1,l)
  83.                     p:=GetName(name,src,p,l)
  84.                     IF (name[0]="0") AND (name[1]="x")
  85.                         name[0]:=" "
  86.                         name[1]:="$"
  87.                         offset:=Val(name)
  88.                     ELSE
  89.                         PrintF('"0x" expected.\n')
  90.                         RETURN
  91.                     ENDIF
  92.                 ELSE
  93.                     PrintF('"," expected.\n')
  94.                     RETURN
  95.                 ENDIF
  96.  
  97.                 p:=Skip(src,p,l)
  98.                 IF src[p]=","
  99.                     p:=Skip(src,p+1,l)
  100.                     p:=GetName(name,src,p,l)
  101.                     VFPrintF(f,'\t\s',[name])
  102.                     i:=0
  103.                     WHILE src[p]<>")"
  104.                         name[i]:=src[p]
  105.                         IF p>=l THEN RETURN
  106.                         IF CtrlC() THEN RETURN
  107.                         i++
  108.                         p++
  109.                     ENDWHILE
  110.                     name[i]:="\0"
  111.                     VFPrintF(f,'\s',[name])
  112.                     IF type="AMIC"
  113.                         VFPrintF(f,')',NIL)
  114.                     ELSEIF type="TAGC"
  115.                         VFPrintF(f,':LIST OF TagItem)',NIL)
  116.                     ENDIF
  117.                 ELSE
  118.                     PrintF('"," expected.\n')
  119.                     RETURN
  120.                 ENDIF
  121.  
  122.                 VFPrintF(f,'(d0)=-\d',[offset])
  123.             ENDIF
  124.         ELSE
  125.             p++
  126.         ENDIF
  127.     EXITIF CtrlC()
  128.     ENDWHILE
  129. ENDPROC
  130.  
  131. PROC ConvertSASC(f,src:PTR TO CHAR,l)
  132.     DEF    p=0,type,head=FALSE,name[256]:STRING,offset,i,num[16]:STRING,n
  133.     WHILE p<l
  134.         WHILE src[p]<>"#"
  135.             p++
  136.             IF p>=l THEN RETURN
  137.             IF CtrlC() THEN RETURN
  138.         ENDWHILE
  139.         IF StrCmp('#pragma',src+p,7)
  140.             p:=Skip(src,p+7,l)
  141.             p:=GetName(name,src,p,l)
  142.             IF StrCmp('libcall',name)
  143.                 type:="LIBC"
  144.             ELSEIF StrCmp('tagcall',name)
  145.                 type:="TAGC"
  146.             ELSE
  147.                 PrintF('Only libcall and tagcall allowed (\s).\n',name)
  148.                 RETURN
  149.             ENDIF
  150.             IF type
  151.                 p:=Skip(src,p,l)                        -> read base
  152.                 p:=GetName(name,src,p,l)
  153.                 IF head=FALSE
  154.                     VFPrintF(f,'LIBRARY \s\n',[name])
  155.                     head:=TRUE
  156.                 ELSE
  157.                     VFPrintF(f,',\n',NIL)
  158.                 ENDIF
  159.  
  160.                 p:=Skip(src,p,l)                        -> read function name
  161.                 p:=GetName(name,src,p,l)
  162.                 VFPrintF(f,'\t\s(',[name])
  163.                 IF name[StrLen(name)-1]="A" THEN type:="TAGL"
  164.  
  165.                 p:=Skip(src,p,l)                        -> read function offset
  166.                 p:=GetName(name,src,p,l)
  167.                 StringF(num,'$\s',name)
  168.                 offset:=Val(num)
  169.  
  170.                 p:=Skip(src,p,l)                        -> read arguments
  171.                 p:=GetName(name,src,p,l)
  172.                 i:=StrLen(name)-3
  173.                 WHILE i>=0
  174.                     n:=name[i]
  175.                     StringF(num,'$\c',n)
  176.                     n:=Val(num)
  177.                     IF (n>=0) AND (n<=7)  THEN VFPrintF(f,'d\d',[n])
  178.                     IF (n>=8) AND (n<=15) THEN VFPrintF(f,'a\d',[n-8])
  179.                     i--
  180.                     IF CtrlC() THEN RETURN
  181.                 EXITIF i<0
  182.                     VFPrintF(f,',',NIL)
  183.                 ENDWHILE
  184.                 IF type="LIBC"
  185.                     VFPrintF(f,')',NIL)
  186.                 ELSEIF type="TAGL"
  187.                     VFPrintF(f,':PTR TO TagItem)',NIL)
  188.                 ELSEIF type="TAGC"
  189.                     VFPrintF(f,':LIST OF TagItem)',NIL)
  190.                 ENDIF
  191.  
  192.                 VFPrintF(f,'(d0)=-\d',[offset])
  193.             ENDIF
  194.         ELSE
  195.             p++
  196.         ENDIF
  197.     EXITIF CtrlC()
  198.     ENDWHILE
  199. ENDPROC
  200.  
  201. PROC Skip(src:PTR TO CHAR,p,l)(L)
  202.     WHILE (src[p]=" ") OR (src[p]="\t")
  203.         p++
  204.         IF p>=l THEN RETURN l
  205.         IF CtrlC() THEN RETURN l
  206.     ENDWHILE
  207. ENDPROC p
  208.  
  209. PROC GetName(dst:PTR TO CHAR,src:PTR TO CHAR,p,l)(L)
  210.     DEF    i=0
  211.     WHILE ((src[p]>="A") AND (src[p]<="Z")) OR ((src[p]>="a") AND (src[p]<="z")) OR ((src[p]>="0") AND (src[p]<="9")) OR (src[p]="_")
  212.         dst[i]:=src[p]
  213.         IF p>=l THEN RETURN l
  214.         IF CtrlC() THEN RETURN l
  215.         i++
  216.         p++
  217.     ENDWHILE
  218.     dst[i]:="\0"
  219. ENDPROC p
  220.  
  221. CHAR '\n\n$VER:pr2m v1.1 by MarK (9.12.2001)\0\n\n'
  222.